perm filename SC1.F4[M11,LCS] blob sn#439879 filedate 1979-05-08 generic text, type T, neo UTF8
C  THIS PROGRAM IS THE PROPERTY OF LELAND SMITH, PROFESSOR OF MUSIC
C  AT STANFORD UNIVERSITY.  IT MAY NOT BE COPIED OR ALTERED IN ANY
C  WAY WITHOUT WRITTEN PERMISSION OF THE AUTHOR.


C  1/79 **********  SCORE - PDP11 VERSION ********** 

C   THIS PROGRAM WRITES NOTE LISTS FOR THE PDP11 MUSIC V SOUND
C   GENERATION PROGRAM.
C   IF # OF INSTS IS CHANGED, ALSO CHANGE # IN 'INFO'('HELP') FORMAT.
C   LOAD 'S1' WITH S2,SCANR

	COMMON /DEVS/ID1,ID21,JTYPE,ID23,ID20
	COMMON /Q/ BNW(200),NWZ /INS/RINST(27),BG(60) /TYP/JOUT,LN,KTYPE
	1 /ITYP/ITYP,JED 
C  SEE LABEL 1774 AND BELOW RE. BUFFER LIMIT.
	COMMON/VV/LIMIT,V(2000) /A/NP(27),XT(27), FRM(80),INVIS(27)
	DIMENSION LIST(1),JNP(80)
C   WITH VX,IOUT AT 70 AND FRM AT 80 OK FOR ONLY 
C   40 LIT CHARS + 30 PARAMS PER INST.
C   60 BG TIMES AVAILABLE. 

C 2ND NUM IN IPT=NUMP+2. (NUMPY) 
	COMMON /PCIP/ PCH(27,33) /ALPH/IALPH(14),ISCA(12),IDAT(11)
	1 /INP/INP(154) 
C NUMP=30 = TOTAL NUMBER OF PARAMETERS NOW AVAILABLE. RAN.DEV. IS NUMP+1
	COMMON J,L /DUR/DUR(27) /NUMP/NUMP,NUMPY,NUMPX
	1 /BLA/IBLA,KSLA,ISEMI,MINUS,ISTAR,ICOMM,ICOL,IQUES,ILESS,IQT
	1/E/IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG
	1 ,VX(70),IAMP,K,KN,M,ML,CODE
	COMMON/B/MOT,PR,T5,NINS,I,RA,KZY,NWX,INONLY,MX,
	1 Y,Z,ISLAC,MZ,N,IDALL,JC,JG,RB,IJ,IX,BW,NL,RC,W,
	1 ZZ,CHN,YY 
	1 /D/TF,AMPFAC,OP1,DURX,IXIN,FLNM
	1  /INTC/LPAR,IPRN,IRETRO,INVRT,ICON,LCNT,
	1 JZ,MLX,IZ,JD,LEND,ITMP,LP,ILIT,NLIT,KTMP,IC,IA
	1  /REALC/QX,PARENS,BY,ALL,QTS,RAX,RD,T4,AC

	EQUIVALENCE (LIST,FRM(3)),(JNP,INP)
	DATA KZY/27/,ISEMI/';'/,LIMIT/2000/,NUMP/30/,KSLA/'/'/,IQT/'"'/
	1,MINUS/'-'/,ISTAR/'*'/,ICOMM/','/,ICOL/':'/,ILESS/'<'/
	DATA IBLA/' '/,TYPE/'TYPE'/,TYPD/'TYPD'/,
	1 HELP/'HELP'/,IQUES/'?'/,EDIT/'EDIT'/
	1 ,ISCA/'C','P','D','O','E','F','Z','G','S','A','T','B'/
	1 ,IDAT/'0','1','2','3','4','5','6','7','8','9','.'/
	1,IALPH/'H','I','J','K','L','M','N','Q','R','U','V','W','X'
	1,'Y'/


	ITYP=0
	JOUT=JTYPE
C*** ABOVE CAUSE TYPEOUT ON SCREEN (PUT IN PROMPT FOR THIS LATER.)
      LPAR=0
      IPRN=0
      QX=0
      MOT=0
      IRETRO=-1 
      INVRT=-1
      ICON=-1
      LCNT=1
      IPAREN=0
      JZ=1  
      IAMP=0
C  IAMP IS 'BLANK LINE'FLAG ON PP1-3.
      T5=0  
      NINS=0
      K=0
      IDALL=-1
      QTS=-1.
      NWZ=1
      BNW(1)=0
      I=1
      KL=0  
      TP=0  
      RA=0  
      CHN=0 
      DO 127 K=1,77,3
127      LIST(K)=0
C  INITIALIZES MOTIVIC LIST FOR ERROR FINDING ROUTINE.
      NWX=0
      BY=-1
      DO 1128 K=1,KZY     
      INVIS(K)=0
      RINST(K)=0
      NP(K)=0
      IQ(K)=0
      DO 1128 L=1,32    
1128   PCH(K,L)=0 

      ITYP=-1
      JED=-1
2112      WRITE(JTYPE,8002)
	READ(JTYPE,1)JNP
	IF(JNP(1).NE.IBLA)GO TO 4112
	IF(FLNM.EQ.0)GO TO 2112
	RNAM=FLNM
C REMEMBERS LAST FILE NAME GIVEN.
	GO TO 129
4112	CALL PACKER(RNAM,JNP)
C**** ONLY UP TO 4 LETTERS IN FILE NAMES.
999      IF(RNAM.NE.EDIT)GO TO 3112
      JED=0
      GO TO 2112
C  'EDIT' GOES TO EDIT MODE
3112  IF(RNAM.NE.TYPE)GO TO 128
      ITYP=0
	FLNM=TYPD
C***************** OPEN AN OUTPUT FILE *********
	CALL DISKO(ID20,FLNM,2)
C KOUT=DEVICE NUMBER, FLNM=FILE NAME, 0=OUTPUT, (-1=INPUT)
      CALL READIT
C******* IS A5 AVAILABLE?? *************
1   	 FORMAT(80A1)
8002      FORMAT(' TYPE FILE NAME--  '$)
300	FORMAT(I,3F)

128	IF(RNAM.NE.HELP)GO TO 129
C *** NO HELP YET***
129        FLNM=RNAM
C*********** OPEN AN INPUT FILE ******************
	CALL DISKO(ID23,FLNM,1)

	CALL OUTINF
C OUTINF IS A DUMMY IF USING 2-PART SCORE. WITH 1-PART SCORE IT PROMPTS
C FOR OUTPUT INFO.
	CALL READIT

      END